home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / tool-inc.zip / ANSICOLR.INC < prev    next >
Text File  |  1990-02-27  |  3KB  |  101 lines
  1.  
  2. (*
  3.  * Copyright 1987, 1989 Samuel H. Smith;  All rights reserved
  4.  *
  5.  * This is a component of the ProDoor System.
  6.  * Do not distribute modified versions without my permission.
  7.  * Do not remove or alter this notice or any other copyright notice.
  8.  * If you use this in your own program you must distribute source code.
  9.  * Do not use any of this in a commercial product.
  10.  *
  11.  *)
  12.  
  13. (*
  14.  * Generation of ANSI codes for color
  15.  *
  16.  *)
  17.  
  18. procedure position(x,y: byte);
  19.    {position cursor}
  20. begin
  21.    _disp(#27'[' + itoa(y) + ';' + itoa(x) + 'f');
  22. end;
  23.  
  24. procedure clear_screen;
  25.    {easee screen in current color}
  26. begin
  27.    _disp(#27'[2J');
  28. end;
  29.  
  30. procedure clear_eol;
  31.    {clear to end of line}
  32. begin
  33.    _disp(#27'[K');
  34. end;
  35.  
  36.  
  37. (* ------------------------------------------------------------ *)
  38. function code_color(control: integer): string20;
  39.    {form an ansi color command}
  40. var
  41.    newcolor: string20;
  42.  
  43. begin
  44.    if graphics and (not message_capture) then
  45.       newcolor := #27'[' + ansi_colors[control] + 'm'
  46.    else
  47.       newcolor := '';
  48.  
  49. {  if newcolor = ansi_ccolor then
  50.       code_color := ''
  51.    else }
  52.    begin
  53.       ansi_ccolor := newcolor;
  54.       code_color := newcolor;
  55.    end;
  56. end;
  57.  
  58.  
  59.  
  60. (* ------------------------------------------------------------ *)
  61. {color selection macros}
  62. function aRED:     string20; begin aRED     := code_color(ansi_RED);     end;
  63. function aGREEN:   string20; begin aGREEN   := code_color(ansi_GREEN);   end;
  64. function aYELLOW:  string20; begin aYELLOW  := code_color(ansi_YELLOW);  end;
  65. function aBLUE:    string20; begin aBLUE    := code_color(ansi_BLUE);    end;
  66. function aMAGENTA: string20; begin aMAGENTA := code_color(ansi_MAGENTA); end;
  67. function aCYAN:    string20; begin aCYAN    := code_color(ansi_CYAN);    end;
  68. function aWHITE:   string20; begin aWHITE   := code_color(ansi_WHITE);   end;
  69. function aGRAY:    string20; begin aGRAY    := code_color(ansi_GRAY);    end;
  70.  
  71. procedure adRED(m: string);    begin _disp(aRED);     pdisp(m); end;
  72. procedure adGREEN(m: string);  begin _disp(aGREEN);   pdisp(m); end;
  73. procedure adYELLOW(m: string); begin _disp(aYELLOW);  pdisp(m); end;
  74. procedure adBLUE(m: string);   begin _disp(aBLUE);    pdisp(m); end;
  75. procedure adMAGENTA(m: string);begin _disp(aMAGENTA); pdisp(m); end;
  76. procedure adCYAN(m: string);   begin _disp(aCYAN);    pdisp(m); end;
  77. procedure adWHITE(m: string);  begin _disp(aWHITE);   pdisp(m); end;
  78. procedure adGRAY(m: string);   begin _disp(aGRAY);    pdisp(m); end;
  79.  
  80. procedure default_color;      begin _disp(code_color(ansi_default)); end;
  81.  
  82.  
  83. (* ------------------------------------------------------------ *)
  84. procedure load_color_constants(name: string65);
  85.    {load a new set of color constants}
  86. var
  87.    fd:   text;
  88.    i:    integer;
  89.  
  90. begin
  91.    if not dos_exists(name) then
  92.       exit;
  93.    assignText(fd,name);
  94.    reset(fd);
  95.    readln(fd);
  96.    for i := 1 to 8 do
  97.       readln(fd,ansi_colors[i]);
  98.    close(fd);
  99. end;
  100.  
  101.